VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmPoll 
   Caption         =   "KeyTax BPC MQ Message to XML Conversion"
   ClientHeight    =   3615
   ClientLeft      =   3060
   ClientTop       =   645
   ClientWidth     =   7995
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3615
   ScaleWidth      =   7995
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdReset 
      Height          =   555
      Left            =   1080
      Picture         =   "frmPoll.frx":0000
      Style           =   1  'Graphical
      TabIndex        =   11
      ToolTipText     =   "Stop Polling / Reset"
      Top             =   2640
      Width           =   500
   End
   Begin VB.CommandButton cmdPause 
      Height          =   555
      Left            =   600
      Picture         =   "frmPoll.frx":0442
      Style           =   1  'Graphical
      TabIndex        =   10
      ToolTipText     =   "Pause Polling"
      Top             =   2640
      Width           =   500
   End
   Begin VB.CommandButton cmdStart 
      Height          =   555
      Left            =   120
      Picture         =   "frmPoll.frx":0884
      Style           =   1  'Graphical
      TabIndex        =   9
      ToolTipText     =   "Begin Polling"
      Top             =   2640
      Width           =   500
   End
   Begin VB.ListBox lstErrors 
      Height          =   1230
      Left            =   0
      TabIndex        =   8
      Top             =   1320
      Width           =   7935
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "Clear"
      Height          =   555
      Left            =   1560
      TabIndex        =   7
      Top             =   2640
      Width           =   1215
   End
   Begin VB.CommandButton cmdNoFtp 
      Caption         =   "No Ftp"
      Enabled         =   0   'False
      Height          =   555
      Left            =   5640
      TabIndex        =   6
      Top             =   2640
      Visible         =   0   'False
      Width           =   500
   End
   Begin MSComDlg.CommonDialog cmnDlg 
      Left            =   6960
      Top             =   2640
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdDeleteErrFile 
      Enabled         =   0   'False
      Height          =   555
      Left            =   6120
      Picture         =   "frmPoll.frx":0CC6
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   2640
      Visible         =   0   'False
      Width           =   500
   End
   Begin VB.CommandButton cmdErrors 
      Caption         =   "Err"
      Height          =   555
      Left            =   5160
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   2640
      Visible         =   0   'False
      Width           =   500
   End
   Begin VB.Timer Timer1 
      Interval        =   10
      Left            =   7440
      Top             =   2640
   End
   Begin VB.ListBox lstProgress 
      Height          =   1230
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   7935
   End
   Begin VB.Label lblDevOrProd 
      Height          =   375
      Left            =   10920
      TabIndex        =   3
      Top             =   120
      Width           =   495
   End
   Begin VB.Label lblTime 
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   0
      TabIndex        =   2
      Top             =   3360
      Width           =   3675
   End
   Begin VB.Label lblFileCount 
      Height          =   255
      Left            =   3720
      TabIndex        =   1
      Top             =   3360
      Width           =   4215
   End
   Begin VB.Menu mnuOptions 
      Caption         =   "&Options"
      Begin VB.Menu mnuSettings 
         Caption         =   "&Settings"
         Begin VB.Menu mnuPolling 
            Caption         =   "&Polling"
         End
      End
      Begin VB.Menu mnuExit 
         Caption         =   "&Exit"
      End
   End
End
Attribute VB_Name = "frmPoll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private strStatus As String
Public blnErrorsViewed As Boolean

Private Sub ReceiveXml()

    Dim strFileFmtErrMsg As String
    Dim strXmlVersDtdHeader As String
    Dim strXmlHeader As String
    Dim strXmlError As String
    Dim strDataValidErrMsg As String
    Dim strOraErr As String
    
    Dim objFileError As Object
    Dim strFileErrorMsg As String
    Dim strDllErrMsg As String
    Dim nNumberOfRecords As String
    Dim strFileName As String
    Dim sLastReferenceID As String
    
    On Error GoTo ReceiveXmlFix
    
    If Timer1.Enabled = True Then
        Timer1.Enabled = False
    End If
        
    'barb: test the error pic - if read and move err files, light should go off
    CheckForErrors
    DisableControls
            
    If ImageUptime Then
    
        frmPoll.lblFileCount.Caption = "Connecting . . . . "
        frmPoll.Refresh

        lngIdxFileCount = 0

        If Not ConnectToDb(strOraErr) Then
            WriteToErr "Unable to connect to Database: " & strOraErr, strFileName
            Exit Sub
        End If

        frmPoll.lblFileCount.Caption = "Checking for Files."
        frmPoll.Refresh
        
        Timer1.Enabled = False
        
       'get next to process in interface_index
RESUME_NEXT_REQUEST:
        Do While objFunctions.ExtractBlobFromDb() = True
            
            If objFunctions.ValidateXmlFormat(strFileFmtErrMsg) Then
                If objFunctions.GetHeaderData Then
                    
                    strDataValidErrMsg = ""
                    
                    If objFunctions.ValidateHeaderData(strDataValidErrMsg) Then
                        'adoConn.BeginTrans
                        If objFunctions.UpdateInterfaceIndex Then
                            
                            'Johann (2009/07/22): Check that the reference id for the last request we did isn't the same as this one, or we'll create dups
'                            Dim rsExistingRequests As ADODB.Recordset
'                            Dim sqlExistingRequests As String
'
'                            sqlExistingRequests = "select count(distinct(req_seq_num)) request_count from dir_interface_index "
'                            sqlExistingRequests = sqlExistingRequests & " where reference_id = '" & IdxVars.Tracking.ReferenceID & "'"
'                            sqlExistingRequests = sqlExistingRequests & " and req_seq_num is not null"
'
'                            Set rsExistingRequests = adoConn.Execute(sqlExistingRequests)
'
'                            Debug.Print IdxVars.InterfaceNo & " - " & IdxVars.Tracking.ReferenceID
'
'                            If rsExistingRequests!request_count > 0 Then
'                                AddProgressMessage ("Index: " & IdxVars.InterfaceNo & " failed: Request exists for reference ID " & IdxVars.Tracking.ReferenceID)
'
'                                'set this record to "Undelivered"
'                                adoConn.Execute ("update dir_interface_index set MQ_STATUS = '05' where interface_no = " & IdxVars.InterfaceNo)
'
'                                Set rsExistingRequests = Nothing
'
'                                GoTo RESUME_NEXT_REQUEST
'                            End If
                            'Johann (2009/07/22): End of change
                            
                            If objFunctions.PassToDll(strDllErrMsg) Then
                                If objFunctions.FileApproved Then
                                    lngIdxFileCount = lngIdxFileCount + 1
                                    AddProgressMessage ("Index: " & IdxVars.InterfaceNo & " processed successfully")
                                    'adoConn.CommitTrans
                                Else
                                     'adoConn.RollbackTrans
                                    If objFunctions.IndicateError Then
                                        AddProgressMessage ("Index: " & IdxVars.InterfaceNo & " failed: Directive data validation failed.")
                                        WriteToErr "Index: " & IdxVars.InterfaceNo & " failed: Directive data validation failed.", strFileName
                                        
                                        'call error dll for data error
                                        Set objFileError = CreateObject("FileError.clsFileError")
                                        
                                        If Not objFileError.CreateErrorFile(IdxVars.InterfaceNo, _
                                                                            "02", _
                                                                            , _
                                                                            , _
                                                                            , _
                                                                            strDataValidErrMsg, _
                                                                            strFileErrorMsg) Then
                                            AddErrorMessage ("CreateErrorFile failed: " & strFileErrorMsg)
                                        End If
                                    Else
                                        AddErrorMessage ("Error on IndicateError")
                                    End If
                                End If
                            Else
                                'adoConn.RollbackTrans
                                If objFunctions.IndicateError Then
                                    If strDllErrMsg <> "" Then
                                        WriteToErr "Error occurred in dll. " & strDllErrMsg & vbCrLf & _
                                        ".  Interface number: " & IdxVars.InterfaceNo & vbCrLf & _
                                        ".  KeyTaxType: " & IdxVars.KeyTaxType & vbCrLf & _
                                        ".  IUserId: " & IdxVars.Request.UserId & vbCrLf & _
                                        ".  MsgId: " & IdxVars.Tracking.MsgId & vbCrLf & _
                                        ".  ReferenceId: " & IdxVars.Tracking.ReferenceID, strFileName
                                        
                                        'call error dll for data error
                                        Set objFileError = CreateObject("FileError.clsFileError")

                                        If Not objFileError.CreateErrorFile(IdxVars.InterfaceNo, _
                                                                            "02", _
                                                                            , _
                                                                            , _
                                                                            , _
                                                                            strDllErrMsg, _
                                                                            "") Then
                                            AddErrorMessage ("CreateErrorFile failed: " & strFileErrorMsg)
                                        End If
                                        Set objFileError = Nothing
                                    End If
                                Else
                                    AddErrorMessage ("Error on IndicateError")
                                End If
                                
                                AddProgressMessage ("Index: " & IdxVars.InterfaceNo & " failed: Unable to send/receive from dll. See error file at C:\Projects\LCB\Exe\ErrLog\" & strFileName)
                                
                            End If
                        Else
                            AddProgressMessage ("Index: " & IdxVars.InterfaceNo & " failed: Unable to pass to update interface table")
                            
                            If objFunctions.IndicateError Then
                                WriteToErr "Index: " & IdxVars.InterfaceNo & " failed: Unable to pass to update interface table", strFileName
                            Else
                                AddErrorMessage ("Error on updating the MQ Status to 06(Error) on the index table")
                            End If
                        End If
                    Else
                    
                        AddProgressMessage ("Index: " & IdxVars.InterfaceNo & " failed: Header Validation failure." & strDataValidErrMsg)
                        
                        If objFunctions.IndicateError Then
                            WriteToErr "Index: " & IdxVars.InterfaceNo & " failed: Directive data validation failed.", strFileName
                            
                            'call error dll for data error
                            Set objFileError = CreateObject("FileError.clsFileError")
                            
                            If Not objFileError.CreateErrorFile(IdxVars.InterfaceNo, _
                                                                "02", _
                                                                , _
                                                                , _
                                                                , _
                                                                strDataValidErrMsg, _
                                                                strFileErrorMsg) Then
                                AddErrorMessage ("CreateErrorFile failed: " & strFileErrorMsg)
                            End If
                            Set objFileError = Nothing
                        Else
                            AddErrorMessage ("Error on IndicateError")
                        End If
                    End If
                Else
                    'produce error file
                End If
            Else
            
                AddProgressMessage ("Index: " & IdxVars.InterfaceNo & " failed: XML format validation failure." & strFileFmtErrMsg)
                
                If objFunctions.IndicateError Then
                    'call error dll for file format error
                    Set objFileError = CreateObject("FileError.clsFileError")
                    
                    If objFileError.CreateErrorFile(IdxVars.InterfaceNo, _
                                                    "01", _
                                                    FileFmtErrVars.Code, _
                                                    FileFmtErrVars.Reason, _
                                                    FileFmtErrVars.Line, _
                                                    FileFmtErrVars.Text, _
                                                    strFileErrorMsg) = False Then
                        AddErrorMessage ("CreateErrorFile failed: " & strFileErrorMsg)
                    End If
                    
                    Set objFileError = Nothing
                Else
                    AddErrorMessage ("Error on IndicateError")
                End If
            End If
            
            'Johann(2009/07/22): Save the last reference ID so we can make sure we don't get dups
            sLastReferenceID = IdxVars.Tracking.ReferenceID
        Loop
        
        AddProgressMessage ("No messages to process")
        
        'ClearScreenProgress
        
        'objSendEMail.SendLogEmail
        'barb: check this
        SaveLastRunDttm
    
        Oracle_Disconnect
                
    End If
    
    Timer1.Enabled = True
    
    'cmdReceiveXml.Enabled = False
    'cmdReceiveXml.Visible = False
    Exit Sub
    
ReceiveXmlFix:
    AddErrorMessage ("ReceiveXml: " & Err.Number & " - " & Err.Description)
    Timer1.Enabled = True
End Sub

Private Sub cmdClear_Click()
    ClearScreenProgress
End Sub

Private Sub Form_Load()

    Dim strCmdLine As String
    Dim strLastSettings As String
    Dim i As Integer
                
    On Error GoTo Form_LoadFix
        
    Set objFunctions = New clsFunctions
    Set objReg = New clsReg
    Set objSendEMail = New clsSendEMail
                   
   CheckForErrors
       
    If objReg.LogFilePath & strCurrentLogFileName <> "" Then
        If Dir(objReg.LogFilePath & strCurrentLogFileName & "*.err") <> "" Then
            objReg.LogErrors = 1
        End If
    End If
    
        
    cmdPause.Enabled = False
    cmdReset.Enabled = False
    
        
    ''Check the command line for any immediate action
    strCmdLine = Command()
    If strCmdLine = "1" Then
        'Poll once then Close
        'frmPoll.Show
        DisableControls
        strStatus = "Running"
        ReceiveXml
        If strStatus = "Running" Then
            Timer1.Enabled = True
        Else
            Timer1.Enabled = False
        End If
    ElseIf strCmdLine = "2" Then
        lngCounter = 1
        'Run
        DisableControls
        PerformPol
    End If
        
    
    Exit Sub
    
Form_LoadFix:
    AddErrorMessage (Now & ": " & "FormSettings_Load: " & Err.Number & " - " & Err.Description)
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Set objReg = Nothing
    Set objSendEMail = Nothing
    Set objFunctions = Nothing
End Sub


Private Sub Frame1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 And Shift = 3 Then
        lngCounter = 15
    End If
End Sub


Private Sub lstErrors_DblClick()
    MsgBox lstErrors.Text
End Sub

Private Sub lstProgress_DblClick()
    MsgBox lstProgress.Text
End Sub

Private Sub mnuExit_Click()
    End
End Sub

Private Sub mnuPolling_Click()

    Dim blnTimerRunning As Boolean

    blnTimerRunning = Timer1.Enabled
    Timer1.Enabled = False
    frmPollSettings.Show vbModal
    Timer1.Enabled = blnTimerRunning
    
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    'CTRL + SHIFT
    If Button = 1 And Shift = 3 Then
        If strStatus = "Paused" Then
            'cmdReceiveXml.Enabled = True
            'cmdReceiveXml.Visible = True
        End If
    End If

End Sub

Private Sub Timer1_Timer()


    '   This sub counts down to the next clean up

    Dim Hours As Long
    Dim strTime As String
    Dim Minutes As Long
    Dim Seconds As Long
    
    If cmdStart.Enabled = True Then
        Exit Sub
    End If
                      
    lblFileCount.Caption = "Waiting . . . . "
    If lngCounter = 0 Then
        lngCounter = objReg.PolTimeInterval * 60
    Else
        lngCounter = lngCounter - 1
    End If
    
    'IF COUNTER > 1 HOUR
    If lngCounter >= (60 * 60) Then
        Hours = CStr((CInt(((lngCounter) + 30) / 60) / 60))
        Minutes = Minutes - (60 * (Hours - 30))
        If Hours > 0 Then
            Minutes = Minutes - 1
        End If
    End If
    
    'IF COUNTER > 1 MINUTE
    If lngCounter > 60 Then
        Minutes = CStr((CLng(lngCounter) + 30) / 60)
        Seconds = Abs(lngCounter - (Minutes * 60) + 30)
        If Minutes = 60 Then
            Hours = Hours + 1
            Minutes = 0
        End If
        If Seconds = 60 Then
            Minutes = Minutes + 1
            Seconds = 0
        End If
    End If
        
    strTime = ConvertDate(lngCounter)
    lblTime.Caption = "Executing  in " & strTime
      
    If lngCounter = 0 Then
        Timer1.Enabled = False
        lblTime.Caption = "Performing Receive XML Filenet run."
        strStatus = "Running"
        'PollProcess
        DisableControls
        ReceiveXml
        If strStatus = "Running" Then
            Timer1.Enabled = True
        Else
            Timer1.Enabled = False
        End If
    End If


End Sub
Public Function ConvertDate(InCounter As Long) As String
'   This function is used to convert the counter to a time stamp
    
On Error GoTo ConvertDateFix
    
    
    Dim intHours As Long
    Dim intMinutes As Long
    Dim intSeconds As Long
    Dim strTime As String
    Dim Pos As Long
    
    intHours = InCounter \ 3600
    'Rich: max polling time: every 24 hours
    If intHours >= 24 Then
        intHours = 23
        intMinutes = 59
        intSeconds = 59
    Else
        intMinutes = (InCounter - (intHours * 3600)) \ 60
        intSeconds = InCounter - (intHours * 3600) - (intMinutes * 60)
    End If
    
    'CONVERTING THE TIME INTERVAL TO A TIME STAMP
    strTime = TimeSerial(intHours, intMinutes, intSeconds)
    
    If InCounter >= 3600 Then
      strTime = Mid(strTime, 1, 8) & " hrs"
    ElseIf InCounter >= 60 Then
      strTime = Mid(strTime, 4, 5) & " mins"
    Else
      strTime = Mid(strTime, 7, 2) & " secs"
    End If
    ConvertDate = strTime
    Exit Function
    
ConvertDateFix:
    AddErrorMessage (Now & ": " & "ConvertDate: " & Err.Number & " - " & Err.Description)
'    If frmCleanUp.picError.Visible = False Then
'        frmCleanUp.picError.Visible = True
'    End If
End Function
Private Sub DisableControls()
       
    mnuOptions.Enabled = False
    cmdStart.Enabled = False
    'cmdCleanUp.Enabled = False
    cmdPause.Enabled = True
    cmdReset.Enabled = True
    
End Sub

Private Sub EnableControls()
        
    mnuOptions.Enabled = True
    cmdStart.Enabled = True
    'cmdCleanUp.Enabled = True
    cmdPause.Enabled = False
    cmdReset.Enabled = False
    
End Sub


Private Sub cmdPause_Click()
    EnableControls
    mnuOptions.Enabled = True
    cmdStart.Enabled = True
    'cmdCleanUp.Enabled = True
    cmdPause.Enabled = False
    cmdReset.Enabled = True
    lblFileCount.Caption = "Paused"
    strStatus = "Paused"
    
End Sub

Private Sub cmdReset_Click()
    EnableControls
    mnuOptions.Enabled = True
    cmdStart.Enabled = True
    'cmdCleanUp.Enabled = True
    cmdPause.Enabled = False
    cmdReset.Enabled = False
    lngCounter = 0
    lblTime.Caption = ""
    lblFileCount.Caption = "Stopped"
    strStatus = "Stopped"
End Sub

Private Sub cmdStart_Click()
    strStatus = "Running"
    DisableControls
    PerformPol
End Sub

Private Sub cmdStart_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 And Shift = 3 Then
        lngCounter = 15
    End If
End Sub
Private Sub PerformPol()
' This sub invokes the timer according to the PolSettings
    
    Dim lngPolTimeInterval As Long
    
    lngPolTimeInterval = objReg.PolTimeInterval
            
    If lngPolTimeInterval <> 0 Then
        Timer1.Enabled = True
        Timer1.Interval = 975 '1000
    Else
        frmPollSettings.Show vbModal
    End If
    
End Sub




Public Function HandleError(strMessage As String, strFileName As String, blCreateErrorFile As Boolean)
    
'    Dim strFileErrorMsg As String
'
'    If objFunctions.IndicateError Then
'        If strDllErrMsg <> "" Then
'            WriteToErr strMessage, _
'                       strFilename
'        End If
'    Else
'        AddErrorMessage ("Error on IndicateError")
'    End If
'
'    If blCreateErrorFile Then
'        Dim objFileError As Object
'
'        'call error dll for file format error
'        Set objFileError = CreateObject("FileError.clsFileError")
'
'        If objFileError.CreateErrorFile(IdxVars.InterfaceNo, _
'                                        "01", _
'                                        FileFmtErrVars.Code, _
'                                        FileFmtErrVars.Reason, _
'                                        FileFmtErrVars.Line, _
'                                        FileFmtErrVars.Text, _
'                                        strFileErrorMsg) = False Then
'            AddErrorMessage ("CreateErrorFile failed: " & strFileErrorMsg)
'        End If
'
'        Set objFileError = Nothing
'    End If
End Function

Public Function CheckForErrors()

    Dim strErrPath As String

    strErrPath = objReg.LogFilePath & "Errors"

    'DETERMINING WHICH LIGHT BULB PICTURE TO DISPLAY (ARE THERE ERRORS OR NOT)
    
    If objReg.LogErrors = 1 Then
        frmPoll.cmdErrors.Picture = LoadPicture(App.Path & "\mis.ico")
        If Dir$(strErrPath) <> "" Then
            'errors have occurred
            frmPoll.blnErrorsViewed = False
            frmPoll.cmdErrors.Enabled = True
        Else
            frmPoll.cmdErrors.Picture = LoadPicture(App.Path & "\happy.ico")
            frmPoll.cmdErrors.Enabled = False
        End If
    Else
        frmPoll.cmdErrors.Picture = LoadPicture(App.Path & "\happy.ico")
        frmPoll.cmdErrors.Enabled = False
    End If

End Function

